home *** CD-ROM | disk | FTP | other *** search
/ CD Actual 9 / CDACTUAL9.iso / share / Dos / VARIOS / pascal / SWAG9605.DDD / 0004_Help on XMS use !!!.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-05-31  |  2.5 KB  |  110 lines
  1.  
  2. program XMS;
  3.  
  4. { Functions to get to the XMS API }
  5.  
  6. var XMS_Driver : pointer;
  7.  
  8. function XMS_get_state : byte; assembler;
  9. asm mov ax,4300h; int 2Fh end;
  10.  
  11. function XMS_get_entry_point : pointer; assembler;
  12. asm mov ax,4310h; int 2Fh; mov ax,bx; mov dx,es end;
  13.  
  14.  
  15. { XMS API }
  16.  
  17. type MoveStruct = record
  18.  length    : longint;
  19.  srcHandle : word;
  20.  srcOffset : longint;
  21.  dstHandle : word;
  22.  dstOffset : longint
  23. end;
  24.  
  25. function XMS_get_version : word; assembler;
  26. asm mov ah,00h; call XMS_Driver end;
  27.  
  28. function XMS_query : word; assembler;
  29. asm mov ah,08h; call XMS_Driver end;
  30.  
  31. function XMS_alloc(size : word) : word; assembler;
  32. asm mov ah,09h; call XMS_Driver; mul dx end;
  33.  
  34. function XMS_free(handle : word) : boolean; assembler;
  35. asm mov ah,0Ah; mov dx,handle; call XMS_Driver end;
  36.  
  37. function XMS_move(var MoveStructPtr : MoveStruct) : boolean; assembler;
  38. asm mov ah,0Bh; push ds; push ds; pop es; lds si,MoveStructPtr; call
  39. es:XMS_Driver; pop ds end;
  40.  
  41. { Main program }
  42.  
  43. var XMS_version, XMS_handle  : word;
  44.  
  45.     a : word;
  46.     b : array[0..1999] of real;
  47.     c : MoveStruct;
  48.     d : boolean;
  49.  
  50.     x,y : word;
  51.  
  52. begin
  53.  if XMS_get_state = $80 then begin
  54.   XMS_driver := XMS_get_entry_point;
  55.  
  56.   XMS_version := XMS_get_version;
  57.   writeln('XMS version           : ', hi(XMS_version), '.', lo(XMS_version));
  58.  
  59.   writeln('Largest available EMB : ', XMS_query, 'KB');
  60.   if XMS_query > 0 then begin
  61.  
  62.    a := longint(XMS_query) * 1024 div sizeof(b);
  63.    XMS_handle := XMS_alloc(XMS_query);
  64.    if XMS_handle > 0 then begin
  65.  
  66.     writeln('Number of arrays      : ', a);
  67.  
  68.     c.length := sizeof(b);
  69.     c.srcHandle := 0;
  70.     c.srcOffset := longint(Addr(b));
  71.     c.dstHandle := XMS_handle;
  72.  
  73.     for x := 0 to pred(a) do begin
  74.      write('Filling array #       : ', x, #13);
  75.      for y := 0 to 1999 do
  76.       b[y] := x * y;
  77.      c.dstOffset := longint(x) * sizeof(b);
  78.      XMS_move(c);
  79.     end;
  80.  
  81.     writeln;
  82.  
  83.     c.srcHandle := XMS_handle;
  84.     c.dstHandle := 0;
  85.     c.dstOffset := longint(Addr(b));
  86.  
  87.     for x := 0 to pred(a) do begin
  88.      write('Checking array #      : ', x, #13);
  89.      c.srcOffset := longint(x) * sizeof(b);
  90.      XMS_move(c);
  91.      d := true;
  92.      for y := 0 to 1999 do
  93.       d := d and (b[y] = x * y);
  94.      if not d then
  95.       writeln('Error in array #      : ', x)
  96.     end;
  97.  
  98.     if not XMS_free(XMS_handle) then
  99.      writeln('Error freeing EMB!')
  100.  
  101.    end else
  102.     writeln('Error Allocating EMB!')
  103.  
  104.   end else
  105.    writeln('No free XMS memory!')
  106.  
  107.  end else
  108.   writeln('No XMS driver found!')
  109. end.
  110.